home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtproces.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  4.7 KB  |  145 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtProcess;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *-----------+----------+------+----------------------------------------*)
  29.  
  30.  
  31.  
  32. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  33. (*                                              *)
  34. (*$R-   Range-Checks                            *)
  35. (*$S-   Stack-Check                             *)
  36. (*                                              *)
  37. (*----------------------------------------------*)
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  45.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  46.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  47.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  48.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  49.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  50.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  51.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  61.  
  62.  
  63.  
  64.  
  65. FROM SYSTEM IMPORT ADDRESS, NEWPROCESS, TRANSFER, TSIZE;
  66.  
  67. TYPE    SIGNAL =        POINTER TO PROCESS;
  68.         PROCESS =       RECORD
  69.                          next:  SIGNAL;
  70.                          queue: SIGNAL;
  71.                          core:  ADDRESS;
  72.                          ready: BOOLEAN;
  73.                         END;
  74.  
  75. VAR     currProcess:    SIGNAL;
  76.  
  77. PROCEDURE StartProcess (p: PROC; n: lCARDINAL);
  78. VAR s0: SIGNAL;
  79.     workSpace: ADDRESS;
  80. BEGIN
  81.  s0:= currProcess;
  82.  ALLOCATE (workSpace,  n);  
  83.  ALLOCATE (currProcess,  TSIZE (PROCESS));  
  84.  WITH currProcess^ DO
  85.   next:= s0^.next;
  86.   s0^.next:= currProcess;
  87.   ready:= TRUE;
  88.   queue:= NIL;
  89.  END;
  90.  NEWPROCESS (p, workSpace, n, currProcess^.core); 
  91.  
  92.  TRANSFER (s0^.core, currProcess^.core);
  93. END StartProcess;
  94.  
  95. PROCEDURE SEND (VAR s: SIGNAL);
  96. VAR s0: SIGNAL;
  97. BEGIN
  98.  IF s # NIL THEN
  99.   s0:= currProcess;  currProcess:= s;
  100.   WITH currProcess^ DO
  101.    s:= queue;  ready:= TRUE;  queue:= NIL;
  102.   END;
  103.   TRANSFER (s0^.core, currProcess^.core);
  104.  END;
  105. END SEND;
  106.  
  107. PROCEDURE WAIT (VAR s: SIGNAL);
  108. (* fuege currProcess in die Schlange (queue) ein *)
  109. VAR s0, s1: SIGNAL;
  110. BEGIN
  111.  IF s = NIL THEN
  112.   s:= currProcess;
  113.  ELSE
  114.   s0:= s;  s1:= s0^.queue;
  115.   WHILE s1 # NIL DO  s0:= s1;  s1:= s0^.queue;  END;
  116.   s0^.queue:= currProcess;
  117.  END;
  118.  s0:= currProcess;
  119.  REPEAT
  120.   currProcess:= currProcess^.next;
  121.  UNTIL currProcess^.ready;
  122.  IF currProcess = s0 THEN  HALT;  END; (* Deadlock sollte nicht sein aber... *)
  123.  s0^.ready:= FALSE;
  124.  TRANSFER (s0^.core, currProcess^.core);
  125. END WAIT;
  126.  
  127. PROCEDURE Awaited (s: SIGNAL): BOOLEAN;
  128. BEGIN
  129.  RETURN s # NIL;
  130. END Awaited;
  131.  
  132. PROCEDURE InitSignal (VAR s: SIGNAL);
  133. BEGIN
  134.  s:= NIL;
  135. END InitSignal;
  136.  
  137. BEGIN
  138.  ALLOCATE (currProcess,  TSIZE (PROCESS));  
  139.  WITH currProcess^ DO
  140.   next:= currProcess;
  141.   ready:= TRUE;
  142.   queue:= NIL;
  143.  END;
  144. END mtProcess.
  145.